home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Amiga Public Domain Connection / APDC Disk #025 - Programming Languages (198x)(Amiga Public Domain Connection)(US)[m][WB].zip / APDC Disk #025 - Programming Languages (198x)(Amiga Public Domain Connection)(US)[m][WB].adf / Modula-2 / m2 / RawDoFmtTest.MOD < prev    next >
Text File  |  1988-03-15  |  2KB  |  74 lines
  1. (********************************************************************************
  2.  
  3. Name         : RawDoFmtTest.MOD
  4. Version      : 1.0
  5. Purpose      : Access To Exec's Private Procedure RawDoFmt
  6. Author       : ms
  7. Created      : 12.4.86 11:15 ms
  8. Modified     : 
  9. Comment      : Used to implement c-procedure  [s, f] printf
  10.                not all standard types are supported! no floating point args!
  11.  
  12. ********************************************************************************)
  13.  
  14. MODULE RawDoFmtTest;
  15.  
  16. FROM Terminal  IMPORT WriteString, Write, WriteLn;
  17. FROM AMIGABase IMPORT Regs, LibCall, ExecBase;
  18. FROM SYSTEM    IMPORT ADR, LONG, ADDRESS;
  19.  
  20. TYPE Arguments = ARRAY [0..15] OF CARDINAL;
  21.  
  22. VAR s, st: ARRAY [0..127] OF CHAR;
  23.     args: Arguments;
  24.  
  25. PROCEDURE RawDoFmt(VAR s: ARRAY OF CHAR; format: ARRAY OF CHAR; args: ADDRESS);
  26. VAR r: Regs; stuffChar: LONGCARD;
  27. BEGIN
  28.   format[HIGH(format)]:=0C;
  29.   stuffChar:=LONG(16C0H,    (*  MOVE.B D0, (A3)+ *)
  30.                   4E75H);   (*  RTS              *)
  31.   r.d[0]:=32;
  32.   r.a[3]:=ADR(s);
  33.   r.a[0]:=ADR(format);
  34.   r.a[1]:=args;
  35.   r.a[2]:=ADR(stuffChar);
  36.   LibCall(ExecBase(), -522, r);
  37. END RawDoFmt;
  38.  
  39. BEGIN
  40.   WriteString('Using RawDoFmt to get formatted output'); WriteLn;
  41.   WriteString('======================================'); WriteLn; WriteLn;
  42.  
  43.   args[0]:=000FFH;
  44.   args[1]:=0AAAAH;
  45.   args[2]:=01234H;
  46.   args[3]:=05678H;
  47.   RawDoFmt(s, "Hex Long: %8lx  Hex Short: %5x  Hex Leading Nulls: %08x ",
  48.            ADR(args));
  49.   WriteString(s); WriteLn;
  50.  
  51.   args[0]:=SHORT(SHIFT(7777777D, -16));
  52.   args[1]:=SHORT(      7777777D);
  53.   args[2]:=1001;
  54.   args[3]:=1002;
  55.   RawDoFmt(s, "Dec Long: %8ld  Dec Short: %5d  Dec Leading Nulls: %08d  ",
  56.            ADR(args));
  57.   WriteString(s); WriteLn; WriteLn;
  58.  
  59.   st:="Dies ist ein Test";
  60.   args[0]:=SHORT(SHIFT(ADR(st), -16));
  61.   args[1]:=SHORT(ADR(st));
  62.  
  63.   RawDoFmt(s, "string left adj  >%-30s< ", ADR(args));
  64.   WriteString(s); WriteLn;
  65.  
  66.   RawDoFmt(s, "string right adj >%30s< ", ADR(args));
  67.   WriteString(s); WriteLn;
  68.  
  69.   RawDoFmt(s, "string as it is  >%s< ", ADR(args));
  70.   WriteString(s); WriteLn; WriteLn;
  71.  
  72. END RawDoFmtTest.  
  73.    
  74.